(library (graph-reader)
  (export read-graph)
  (import (except (rnrs base)
                  let-values
                  map
                  error
                  vector-map)
          (only (guile)
                lambda* λ
                ;; strings
                string-null?
                ;; lists
                map
                ;; output
                simple-format
                current-output-port)

          ;; standard library
          (ice-9 pretty-print)
          (ice-9 peg)
          (ice-9 match)
          ;; (ice-9 format)

          ;; custom modules
          (fileio)
          (pipeline)
          (debug)
          (list-helpers)

          ;; parsing
          (prefix (peg-tree-utils) peg-tree:)

          ;; lists
          (except (srfi srfi-1) split-at map)
          ;; receive
          (srfi srfi-8)
          ;; functional records
          (srfi srfi-9 gnu)
          ;; hash tables
          (srfi srfi-69)
          ;; let-values
          (srfi srfi-11)

          (graph-grammar)
          (graph-model))


  (define parse-nodes
    (λ (line)
      (peg:tree
       (match-pattern NODE line))))


  (define node-parse-tree->node
    (λ (tree)
      (make-node (car (peg-tree:tree-refs tree '(NODE NODE-NAME)))
                 (string->number (car (peg-tree:tree-refs tree '(NODE COORDS Y))))
                 (string->number (car (peg-tree:tree-refs tree '(NODE COORDS X)))))))


  (define parse-associations
    (λ (line)
      (-> line
          (match-pattern ASSOCIATION)
          peg:tree)))


  (define assoc-parse-trees->neighbor-assocs
    (λ (assocs-parse-trees)
      (let iter
          ([trees° assocs-parse-trees]
           [previous-node-name°
            (car (peg-tree:tree-refs (first assocs-parse-trees)
                                     '(SOURCE-NODE-NAME)))]
           [neighbors° '()]
           [nodes-to-neighbors° '()])
        (cond
         [(null? trees°)
          (alist->hash-table
           (cons (cons previous-node-name° neighbors°)
                 nodes-to-neighbors°))]
         [else
          (let* ([tree (first trees°)]
                 [source-node-name
                  (car (peg-tree:tree-refs tree '(SOURCE-NODE-NAME)))]
                 [neighbor-name
                  (car (peg-tree:tree-refs tree '(TARGET-NODE-NAME)))])
            (cond
             [(string=? source-node-name previous-node-name°)
              (iter (drop trees° 1)
                    previous-node-name°
                    (cons neighbor-name neighbors°)
                    nodes-to-neighbors°)]
             [else
              (iter (drop trees° 1)
                    source-node-name
                    (list neighbor-name)
                    (cons (cons previous-node-name° neighbors°)
                          nodes-to-neighbors°))]))]))))


  (define assoc-parse-trees->distances
    (λ (assoc-parse-trees nodes-table)
      "Take a list of parse trees and return a map from 2 nodes
which have a neighbor relationship to the distance between
them."
      (let iter
          ([trees° assoc-parse-trees]
           [nodes-to-neighbors° '()])
        (cond
         [(null? trees°)
          (alist->hash-table nodes-to-neighbors°)]
         [else
          (let* ([tree (first trees°)]
                 [node-name (car (peg-tree:tree-refs tree '(SOURCE-NODE-NAME)))]
                 [neighbor-name (car (peg-tree:tree-refs tree '(TARGET-NODE-NAME)))]
                 [weight (string->number (car (peg-tree:tree-refs tree '(WEIGHT))))])
            (iter (drop trees° 1)
                  (cons (cons (cons node-name neighbor-name) weight)
                        nodes-to-neighbors°)))]))))


  (define read-graph
    (λ (input-filename)
      "Takes an input filename, parses the nodes of a graph from
that file and returns 3 values: (1) the nodes, (2) a hash
table of distances between nodes, (3) a hash table of node
names to nodes."
      (let ([lines (get-lines-from-file input-filename)])

        (let-values ([(node-lines association-lines)
                      (split-at lines (λ (line index) (string-null? line)))])

          (let ([assoc-parse-trees (map parse-associations association-lines)]
                [nodes-parse-trees (map parse-nodes node-lines)])

            (let* (;; To fill in the neighbors, we need to parse the associations.
                   [nodes-no-neighbors (map node-parse-tree->node nodes-parse-trees)]
                   [associations (assoc-parse-trees->neighbor-assocs assoc-parse-trees)]
                   [nodes
                    (map (λ (node)
                           (set-node-neighbors
                            node
                            (hash-table-ref associations (node-name node))))
                         nodes-no-neighbors)]
                   [nodes-table (alist->hash-table
                                 (map (λ (node) (cons (node-name node) node))
                                      nodes))]
                   [distances-table (assoc-parse-trees->distances assoc-parse-trees
                                                                  nodes-table)])

              (simple-format #t "nodes no neighbors:\n")
              (pretty-print nodes-no-neighbors
                            #:width 80
                            #:max-expr-width 80)

              (simple-format #t "associations:\n")
              (pretty-print (hash-table->alist associations))

              (simple-format #t "nodes:\n")
              (pretty-print nodes
                            #:width 80
                            #:max-expr-width 80)

              (simple-format #t "distances-table:\n")
              (pretty-print (hash-table->alist distances-table)
                            #:width 80
                            #:max-expr-width 80)

              (simple-format #t "nodes-table:\n")
              (pretty-print (hash-table->alist nodes-table)
                            #:width 80
                            #:max-expr-width 80)

              (values nodes
                      distances-table
                      nodes-table))))))))
